home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Languages / Yerk 3.64 ƒ / Module source / Exam < prev    next >
Encoding:
Text File  |  1992-05-16  |  4.4 KB  |  185 lines  |  [TEXT/ttxt]
  1. \ exam - examine memory in a window
  2. \ 12/20/84  cbd version  1
  3. \  9/17/86  cdn Ignore keystrokes while exam window active
  4. \ 12/04/87    rfl Fixed up mistakes
  5. \  9/26/90    rfl    now memory examined is only application's
  6. \ 12/18/90    rfl    initFont when bring window up
  7. \  2/28/92    rfl    let it be dragged in grayrgn
  8. \  5/16/92    rfl    modified for displaying larger memory address for virtual memory
  9. Decimal
  10.  
  11. :Module examMod
  12. Locked
  13.  
  14. // Ctl
  15. Forget useWFont
  16. // CtlWind
  17. // vScroll
  18.  
  19. :CLASS scrollRect <super rect
  20.    var scrollRegion
  21. ( dh dv -- )
  22.   :M Scroll: pack abs: self swap get: scrollRegion call scrollrect ;M 
  23.   :M New: 0 call NewRgn put: scrollRegion ;M
  24.   :M Kill: get: scrollRegion call disposeRgn 0 put: scrollRegion ;M
  25.   :M ptIn: word0 where: themouse pack abs: self call ptinrect i->l ;M
  26. ;CLASS
  27.  
  28. ctlWind exWind
  29. vscroll exvs
  30.  
  31. control relBtn
  32. radioID init: relBtn
  33.  
  34. control absBtn
  35. radioID init: absBtn
  36.  
  37. control hereBtn
  38. control addrBtn
  39. control wordBtn
  40.  
  41. rect thePane
  42. 62 24 475 205 put: thePane
  43.  
  44. scrollRect scAddr
  45. 04 24 60 203 put: scAddr
  46.  
  47. scrollRect scRect
  48. scRect =: thePane    \ for scrolling
  49. 1 1 inset: scRect
  50.  
  51. 0 value start
  52. 0 value xbase
  53. 0 value xcurs
  54.  
  55. 16 constant nLines    \ max lines for examine window
  56. : maxMem  $ 108 -base @  ;
  57.  
  58. \ ( addr -- )  set exVs,start to page starting at absolute addr
  59. : >>page  0 +base max $ 130 -base @  256 - min  -> start start 256 / put: exvs  ;
  60.  
  61. : exam alive: exWind
  62.     IF select: exWind
  63.     ELSE 29 40 529 280 put: tempRect
  64.         tempRect " Examine" 4 true true  new: exWind
  65.         setLimits: exWind false setGrow: exWind
  66.         20 215 " Abs" exWind new: absBtn
  67.         80 215 " Rel" exWind new: relBtn
  68.         150 215 " Here" exWind new: hereBtn
  69.         245 215 " Address" exWind new: addrBtn
  70.         370 215 " Word" exWind new: wordBtn
  71.         getVrect: exWind 2drop 242  exWind new: exVs
  72.         0  +base 256 / $ 130 -base @  256 / putRange: exVs here +base >>page
  73.         1 put: relBtn  0 put: absBtn
  74.         new: scAddr new: scRect initFont
  75.     THEN ;
  76.  
  77. : clrChr
  78.     @xy 2dup 11 - 2swap swap 18 + swap
  79.     put: temprect clear: temprect  ;
  80.  
  81. : bcorrect get: relBtn  IF  -base  THEN ;
  82.  
  83. \ draw numeric legend for the pane
  84. : .Legend base hex curs -curs
  85.     1 tmode getTopX: thePane 1- getTopY: thePane 2- gotoxy
  86.     16 0
  87.     DO clrChr start bcorrect i+ $ 0F and 3 .r
  88.     LOOP @xy swap 14 + swap gotoxy  16 0
  89.     DO clrChr start bcorrect
  90.         i+ $ 0F and 0 <# # #> type
  91.     LOOP  -> curs -> base ;
  92.  
  93. \ ( line# -- Yval ) goto xy for line#
  94. : lineY  11 * getTopY: thePane + 11 + 4 swap gotoxy ;
  95.  
  96. : .addrs base hex curs -curs 16 0 DO i lineY 
  97.     start i 16 * + bcorrect ( $ FFFFFF and 6) 9 .r cr LOOP -> curs -> base ;
  98.  
  99. \ ( addr -- )  dump a line of memory from absolute addr
  100. : .line  { addr \ hiAddr -- } base hex curs -curs
  101.     addr  16 + -> hiAddr
  102.     addr bcorrect 9 .R space
  103.     hiAddr addr
  104.     DO  i -base c@ space 0 <# # # #> type
  105.     LOOP 2 spaces  hiaddr addr
  106.     DO  i -base c@ dup 32 < over 126 > or
  107.     IF drop 46
  108.     THEN  emit
  109.     LOOP -> curs -> base ;
  110.  
  111. \ ( addr ) dump nlines of data from absolute addr for the examine window
  112. : .page { addr -- }
  113.     nlines 0
  114.     DO   i lineY  addr i 16 * + .line
  115.     LOOP  ;
  116.  
  117. \ draw the examine page
  118. : drawPage
  119.     base -> xbase hex
  120.     curs -> xcurs -curs
  121.     clear: scRect  clear: scAddr
  122.     draw: thePane
  123.     .legend  1 tmode  start  .page
  124.     xcurs -> curs
  125.     xbase -> base ;
  126.  
  127. \ ( yVal -- ) scroll by yval
  128. : scrollPage { yval -- }
  129.     0 yVal scroll: scAddr
  130.     0 yval scroll: scRect ;
  131.  
  132. : doDn
  133.     -11 scrollPage  15 lineY
  134.     start 16 + $ 130 -base @  min >>page
  135.     start 240 + .line ;
  136.  
  137. : doUp
  138.     start
  139.     IF 11 scrollPage  0 lineY  start 16 - 0 +base max  >>page
  140.     start  .line THEN  ;
  141.  
  142. : +rel    0 put: absBtn 1 put: relBtn clear: scAddr .legend .addrs ;
  143. : -rel    1 put: absBtn 0 put: relBtn clear: scAddr .legend .addrs ;
  144.  
  145. : >here  here +base >>page update: exWind  ;
  146.  
  147. \ get a new start address from input dialog and dump
  148. : >addr
  149.     base -> xbase hex
  150.     " Dump from hex address:" doInDlg
  151.     IF    here >str255 1+ here c@ >uc
  152.         BL here count + c!
  153.         here number drop  get: relBtn
  154.         IF  +base  THEN  >>page update: exWind
  155.     THEN
  156.     xbase -> base ;
  157.  
  158. \ get a word name from input dialog and dump it
  159. : >word
  160.     " Dump from name:" doInDlg
  161.     IF    sFind
  162.         IF drop nfa  +base  >>page update: exWind
  163.         THEN
  164.     THEN  ;
  165.  
  166. : PgUp  start 256 -  >>page  drawPage ;
  167. : PgDn  start 256 +  >>page  drawPage  ;
  168. \ : doThumb  start 256 * put: exVs ;
  169. : doThumb get: exVs 256 * -> start update: exWind ;
  170.  
  171. : closEx
  172.     kill: scRect kill: scAddr
  173.     'c exammod munlock ;
  174.  
  175. 5 'cfas doup dodn Pgup Pgdn doThumb actions: exVs
  176. 4 'cfas closEx null drawPage null actions: exWind
  177.  
  178. 'c +rel  actions: relBtn
  179. 'c -rel  actions: absBtn
  180. 'c >here actions: herebtn
  181. 'c >addr actions: addrBtn
  182. 'c >word actions: wordBtn
  183.  
  184. ;Module
  185.